PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/cert/trk3_eg/vbx/frmmain.frm

Visual Basic Form | 1994-01-26 | 11.2 KB | 419 lines

VERSION 2.00
Begin Form frmMain
   Caption         =   "Custom AutoLoad"
   ClientHeight    =   3480
   ClientLeft      =   1320
   ClientTop       =   2265
   ClientWidth     =   8475
   Height          =   3885
   Left            =   1260
   LinkTopic       =   "Form1"
   ScaleHeight     =   3480
   ScaleWidth      =   8475
   Top             =   1920
   Width           =   8595
   Begin CommandButton CmdClose
      Caption         =   "Cl&ose"
      Height          =   495
      Left            =   6960
      TabIndex        =   22
      Top             =   1560
      Width           =   1215
   End
   Begin CommandButton cmdMove
      Caption         =   "Insert Co&m"
      Height          =   375
      Index           =   4
      Left            =   3840
      TabIndex        =   21
      Top             =   2280
      Width           =   1095
   End
   Begin PictureBox picBad
      BackColor       =   &H000000FF&
      Height          =   285
      Left            =   4485
      Picture         =   FRMMAIN.FRX:0000
      ScaleHeight     =   255
      ScaleWidth      =   255
      TabIndex        =   20
      Top             =   3000
      Visible         =   0   'False
      Width           =   285
   End
   Begin PictureBox picGood
      BackColor       =   &H0000FF00&
      Height          =   285
      Left            =   4755
      Picture         =   FRMMAIN.FRX:228FA
      ScaleHeight     =   255
      ScaleWidth      =   255
      TabIndex        =   19
      Top             =   3000
      Visible         =   0   'False
      Width           =   285
   End
   Begin TextBox txtEdit
      Height          =   285
      Left            =   5040
      TabIndex        =   18
      Top             =   3000
      Width           =   3015
   End
   Begin CommonDialog CMDialog1
      CancelError     =   -1  'True
      Left            =   7680
      Top             =   0
   End
   Begin CommandButton cmdSaveas
      Caption         =   "&Sa&ve As"
      Height          =   495
      Left            =   6960
      TabIndex        =   16
      Top             =   960
      Width           =   1215
   End
   Begin CommandButton cmdCancel
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   495
      Left            =   6960
      TabIndex        =   13
      Top             =   2400
      Width           =   1215
   End
   Begin CommandButton cmdSave
      Caption         =   "&Save"
      Default         =   -1  'True
      Height          =   495
      Left            =   6960
      TabIndex        =   12
      Top             =   360
      Width           =   1215
   End
   Begin CommandButton cmdMove
      Caption         =   "&Clear <<"
      Height          =   375
      Index           =   3
      Left            =   3840
      TabIndex        =   11
      Top             =   1800
      Width           =   1095
   End
   Begin CommandButton cmdMove
      Caption         =   "A&ll >>"
      Height          =   375
      Index           =   2
      Left            =   3840
      TabIndex        =   10
      Top             =   1320
      Width           =   1095
   End
   Begin CommandButton cmdMove
      Caption         =   "&Delete <"
      Height          =   375
      Index           =   1
      Left            =   3840
      TabIndex        =   9
      Top             =   840
      Width           =   1095
   End
   Begin CommandButton cmdMove
      Caption         =   "&Add >"
      Height          =   375
      Index           =   0
      Left            =   3840
      TabIndex        =   8
      Top             =   360
      Width           =   1095
   End
   Begin ComboBox lstType
      Height          =   300
      Left            =   1800
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   3000
      Width           =   1935
   End
   Begin ListBox lstVBX
      Height          =   2175
      Left            =   5040
      TabIndex        =   3
      Top             =   360
      Width           =   1695
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   120
      TabIndex        =   2
      Top             =   3000
      Width           =   1575
   End
   Begin DirListBox Dir1
      Height          =   2055
      Left            =   120
      TabIndex        =   1
      Top             =   360
      Width           =   1575
   End
   Begin FileListBox File1
      Height          =   2175
      Left            =   1800
      TabIndex        =   0
      Top             =   360
      Width           =   1935
   End
   Begin Label lblEdit
      Caption         =   "Edit &Field"
      Height          =   255
      Left            =   5040
      TabIndex        =   17
      Top             =   2760
      Width           =   1095
   End
   Begin Label lblDrive
      Caption         =   "Driv&e"
      Height          =   255
      Left            =   120
      TabIndex        =   15
      Top             =   2760
      Width           =   1215
   End
   Begin Label Label1
      Caption         =   "Di&rectory"
      Height          =   255
      Left            =   120
      TabIndex        =   14
      Top             =   120
      Width           =   1215
   End
   Begin Label lblvbx
      Caption         =   "Autoload VB&X List"
      Height          =   255
      Left            =   5040
      TabIndex        =   6
      Top             =   120
      Width           =   1695
   End
   Begin Label lblsysVBX
      Caption         =   "&Installed VBX's"
      Height          =   255
      Left            =   1800
      TabIndex        =   5
      Top             =   120
      Width           =   1815
   End
   Begin Label lblType
      Caption         =   "&Type"
      Height          =   255
      Left            =   1800
      TabIndex        =   4
      Top             =   2760
      Width           =   1695
   End
Option Explicit
Sub addAllvbx ()
Dim i As Integer
    If File1.ListCount > 0 Then
        For i = 0 To File1.ListCount - 1
            Dim addflag As Integer
            Dim j As Integer
            addflag = True
            If lstvbx.ListCount > 0 Then
                For j = 0 To lstvbx.ListCount - 1
                    If File1.List(i) = lstvbx.List(j) Then
                        addflag = False
                        Exit For
                    End If
                Next
            End If
        If addflag Then lstvbx.AddItem File1.List(i)
        Next
    End If
End Sub
Sub Addvbx ()
Dim i As Integer
Dim addflag As Integer
addflag = True
If lstvbx.ListCount > 0 Then
    For i = 0 To lstvbx.ListCount - 1
        If File1.List(File1.ListIndex) = lstvbx.List(i) Then
            addflag = False
            Exit For
        End If
    Next
End If
reposList (File1.List(File1.ListIndex))    'Adds item a put in proper place
End Sub
Sub cmdCancel_Click ()
Unload Me
End Sub
Sub cmdClose_Click ()
Dim rs As Integer
If listchange Then
    rs = MsgBox("Your vbx list has changed would you like to save before closing.", MB_YesNO, "Closing")
    Select Case rs
        Case IDYes
            'Go back to main dialog box
        Case IDNo
            Unload Me
    End Select
    Unload Me
End If
End Sub
Sub cmdMove_Click (index As Integer)
Select Case index
    Case 0
        Addvbx
    Case 1
        removevbx
    Case 2
        addAllvbx
    Case 3
        lstvbx.Clear
    Case 4
        InsertCom
End Select
End Sub
Sub cmdSave_Click ()
If frmmain.Caption = "*.AVB" Then
    cmdSaveas_Click
Fillfile curmodfile
End If
listchange = False
End Sub
Sub cmdSaveas_Click ()
Dim rs As String
Dim passfilename As String
passfilename = frmmain.Caption
rs = saveasvbx(passfilename)
curmodfile = rs
If rs = "cancel" Then
    Exit Sub
End If
frmmain.Caption = rs
Fillfile rs
listchange = False
End Sub
Sub Dir1_Change ()
File1.Path = Dir1.Path
End Sub
Sub Drive1_Change ()
Dir1.Path = Drive1.Drive
End Sub
Sub Editoff ()
    picBad.Visible = False
    picGood.Visible = False
End Sub
Sub EditOn ()
    picBad.Visible = True
    picGood.Visible = True
End Sub
Sub File1_DblClick ()
Dim i As Integer
Call Addvbx
End Sub
Sub Form_Load ()
Dim winSysPath As String
lstType.AddItem "VBX (*.VBX)"
lstType.AddItem "All (*.*)"
lstType.ListIndex = 0
Windir = FindWinDir()
Drive1.Drive = Left$(Windir, 2)
winSysPath = Windir & "system\"
Dir1.Path = winSysPath
Editoff
End Sub
Sub InsertCom ()
End Sub
Sub lstType_Click ()
Dim newpattern As String
Dim stpos As Integer
Dim Endpos As Integer
newpattern = lstType.Text
stpos = InStr(1, newpattern, "(")
Endpos = InStr(1, newpattern, ")")
newpattern = Mid(newpattern, stpos + 1, Endpos - stpos - 1)
File1.Pattern = newpattern
End Sub
Sub lstVBX_Click ()
Dim listline As String
listline = lstvbx.Text
If Not (Right$(listline, 4) = ".VBX" Or Left$(listline, 1) = "'") Then
    txtedit.Text = listline
    EditOn
    txtedit.Text = ""
    Editoff
End If
listchange = True
End Sub
Sub lstVBX_DblClick ()
    removevbx
End Sub
Sub picBad_Click ()
Editoff
End Sub
Sub picCancel_Click ()
Editoff
End Sub
Sub picGood_Click ()
Dim rs As Integer
Editoff
rs = MsgBox("Are you sure you would like to update the line:  " & lstvbx.Text, MB_YesNO, "Confirm edits!!")
Select Case rs
    Case IDYes
        lstvbx.Text = txtedit.Text
End Select
End Sub
Sub picInput_Click ()
Editoff
End Sub
Sub removevbx ()
If Not (lstvbx.ListCount = 0 Or Left(lstvbx.Text, 8) = "ProjWinS") Then
    lstvbx.RemoveItem lstvbx.ListIndex
End If
End Sub
Sub reposList (insertdata As String)
Dim curindex As Integer
Dim curlistcount As Integer
Dim tempcnt As Integer
Dim templistdata() As String
Dim cnt As Integer
Dim bottommes As String
Dim bottomrs As Integer
Dim rs As Integer
curindex = lstvbx.ListIndex
curlistcount = lstvbx.ListCount
If curindex = -1 And curlistcount <= 2 Then
    curindex = curlistcount - 2
ElseIf curindex = -1 And Not curlistcount = 0 Then
    bottommes = "You have not specified a location to put this vbx in the list.  Would you like to put the vbx control on the bottom of the list?"
    rs = MsgBox(bottommes, MB_YesNO, "VBX position alert")
    Select Case rs
        Case IDYes
            curindex = curlistcount - 2
        Case IDNo
            Exit Sub
    End Select
End If
If curindex >= curlistcount - 1 Then
    MsgBox "The ProjWinSize and the ProjWinS must be the last two entries in the VBX file.  Your add can not be completed."
    ReDim templistdata(1 To curlistcount - curindex) As String
    For cnt = curlistcount - 1 To curindex Step -1
        tempcnt = tempcnt + 1
        templistdata(tempcnt) = lstvbx.List(cnt)
        lstvbx.RemoveItem cnt
    Next cnt
    lstvbx.AddItem UCase$(insertdata)
    For cnt = 1 To tempcnt
        lstvbx.AddItem templistdata(cnt)
    Next
End If
End Sub
Sub txtEdit_Change ()
    EditOn
End Sub
Sub txtEditField_GotFocus ()
EditOn
End Sub